home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / D-G / FORTRAN Goodies / NewRes.txt < prev    next >
Encoding:
Text File  |  1992-11-03  |  1.2 KB  |  65 lines  |  [TEXT/MPS ]
  1. C    NewRes.f is an example of how to use Toolbox calls
  2. C    to create, write to, and read from the resource fork
  3. C    of a file. ResEdit or some sort of resource editor
  4. C    may be useful for viewing the file you create.
  5.  
  6. C    Example provided for owners of Language Systems FORTRAN
  7. C    © 1992 Language Systems Corp.
  8.  
  9. !!G Toolbox.finc
  10. !!MP Inlines.f
  11.  
  12.     program sinped
  13.     
  14.     record /StringHandle/ aStr
  15.     integer*2 theResFile
  16.     integer*2 IDnum
  17.     string*255 astring
  18.     
  19.     string*255 filename
  20.         
  21.     OPEN ( 83,
  22.     1    FILE = *,
  23.     2    ACCESS = 'DIRECT',
  24.     3    FORM = 'UNFORMATTED',
  25.     4    RECL = 8192,
  26.     5    STATUS = 'NEW',
  27.     6    FILETYPE = 'Sd2f',
  28.     7    CREATOR = 'Appl',
  29.     8    ERR = 803)
  30.     
  31.     INQUIRE(83,NAME=filename)
  32.     
  33.     call CreateResFile(filename)            
  34.     theResFile = OpenResFile(filename)    
  35.         
  36.     IDnum = 1001
  37.     astring = '\p23456789'                                
  38.     aStr = NewString(astring)                
  39.     
  40.     astring = '\psample-size'                    
  41.     call AddResource(aStr,'STR ',IDnum,astring)
  42.     
  43.     call WriteResource(aStr)
  44.     call UpdateResFile(theResFile)
  45.     call CloseResFile(theResFile)
  46.     
  47.     CLOSE (83)
  48.  
  49. C    Try to read the resource
  50.     
  51.     astring = ' '
  52.     theResFile = OpenResFile(filename)
  53.     IDnum = 1001
  54.     aStr = GetString(IDnum)
  55.  
  56.     astring = aStr.H^.P^
  57.     write(*,*) 'astring = ',astring
  58.     
  59.     call CloseResFile(theResFile)
  60.     STOP 'NORMAL EXIT'
  61.  
  62. 803    CONTINUE
  63.     STOP 'ERROR OPENING OUTPUTFILE'
  64.     
  65.     END